00100	C***** AIDS IN EXTRACTING PARTS FROM SCORES AND DOES AUTOMATIC PAGE LAYOUT. 
00200	C***************************** THERE ARE STILL SEVERAL BUGS IN THIS PROG.
00300	C***************************** TRANSPOSE-ONLY IS NOT FULLY TESTED.
00400	C*********** TRANSPOSITION OF 'F' PARTS IN BASS CLEF HAS SOME PROBLEMS.
00500	C***************************** ETC., ETC.    8/78
00600	
00700	C SEE PAGE.CMD FOR LOADING INSTRUCTIONS
00800	C **** SUBROUTINE LIST *****
00900	C PAGE:  READX
01000	C RESPC:
01100	C RESTP:
01200	C WRTPAG: 
01300	C PGSUB: FILOUT(NAMQ,NPG), FILEIN, STAVES
01400	C TRONLY: 
01500	C TRNSP: TRNSP, RVRS
01600	C PTMOVX: PTMOVE, TURN
01700	C FNDTRN: MNMX, FNDTRN, BRJUGL, GET
01800	C PFAIL: LOOKF,LOOKX,LOOK,SHFTQ,SORT2,NORH,FNDEND,MINMAX,RLOOP,BLTEM,IFIX,FLOAT
01900	C	 GETPTS,MOVIT,EXTEN,DBAR,QRN,SORT,SHIFT,SHFT1,SHFT0,PSHFT,ADRST,STAFF
02000	C        RIGHT,RESTS,EXCHG,EXCH,SHRNK,EXPND,CLFNUM,SLRV,CLEFN,MMNN,CODEN,ZERO 
02100	C EXT:   PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
02200	
02300		COMMON/STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,JPQ
02400		1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
02500		1 RCLEF(0/7) /RSIG/RSIG(0/7) /IVV/NRD(200)
02600		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
02700	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
02800		COMMON/XRN/RN(3500) /SF/KL,RT,KP,STFSZ,NAMX,EXT
02900		1 /PTR/KWDS(350)/LLL/LLL,LL,I,IX,XSIG/XXX/LK,LP,JY /JN/J,N
03000	C  INCREASE DIMENSION OF KWDS (KPN & Q) FOR VERY FULL PAGES.
03100	      DIMENSION MM(1500),NN(1500),BARS(509),STFNM(0/7),KSAVE(30),
03200		1 RMETER(0/7),RCL(0/7),NUMS(30),PGTRN(500),SAVES(470),U(1)
03300	C KSAVE AND SAVES ARE TO SAVE REHEARSAL NUMS, ETC. -- LIMIT=30
03400		COMMON /PX/KPN(450) /Q/Q(4000) /KBAR/KBAR(1027) /IRST/IRST
03500	 	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
03600		1 /RSP/KNM(100) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT,LASTNM
03700		1 /JWDS/JWDS(300),RRN(3000)
03800	C  JWDS IS EQUIVALENCED IN PTMOVX.F4 AND RESTP.F4
03900		DATA FIB/.7/,RSPC/25./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.0/
04000		1 ,RLTRSZ/1.0/,SPCPG/2.7/
04100		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
04200		1,(MM,RN),(NN,RN(1501)),(KS,RS),(BARS,KBAR(4)),(JRSTF,RSTJ2)
04300		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
04400		1,(STFNM,KBAR(508)),(NUM1,NUMS,KPN),(PGTRN(1),KBAR(5 16))
04500		1,(SAVES,Q(3001)),(KSAVE,Q(3475)),(U,KBAR(1026))
04600	C  HANDLES 503 PAGES AND PAGE-TURN INFO. IN KBAR AND PGTRN
04700	C  RQ(2) IS R4, RQ(3) IS R5 ETC.  STAFF NAMES START AT KBAR(508)=STF(0)
04800	
04900		RN(2)=0
05000		EXT='MS'
05100		IRST=0
05200	C IRST IS USED IN SUBROUTINE RESTP
05300		IPG=0
05400		KBR=0
05500		NMPG='PAGEA'
05600		JPG=0
05700		JRD=1
05800		ENDLN=0
05900		SAVSIZ=0
06000		ISN=0
06100		NCNT=10000
06200		IFOUND=0
06300	
06400		TYPE 1000   
06500		ACCEPT 2000,NAMX
06600		IF(NAMX.EQ.0)CALL PT2
06700		IF(NAMX.EQ.3)CALL TRONLY
06800		NPG=NAMX-2
06900		TYPE 3300
07000		IF(NPG.GE.0)GO TO 3000
07100	CC	IF(NPG.GE.0)TYPE 3
07200		ACCEPT 2,KS,NTYPE
07300	C  TYPE -1 AFTER NAME(I.E.5 SPACES) TO PRINT INST. NAMES AS READ.
07400	CC	NAMZ=KS
07500		JNM=1
07600	
07700		CALL LO2UP(KS)
07800	143	CALL IFILE(1,KS)
07900		READ(1,2)K
08000	CC843	READ(1,2)K
08100		IF(K.NE.'COMME')GO TO 543
08200	743	READ(1,643),K,K,K
08300	C  READ ET DIRECTORY !∃∀ βλπα∀πεβα!ββX!
08400		IF(K.NE.';')GO TO 743
08500		READ(1,2)K
08600		GO TO 843
08700	C  FIRST LINE MUST BE EXTENSION NAME
08800	643	FORMAT(3A1)
08900	2	FORMAT(A5,30I)
09000	CC3	FORMAT(' TYPE FILE NAME.EXT -- '$)
09100	3300	FORMAT(' TYPE FILE NAME -- '$)
09200	1000	FORMAT(' 1=PARTS, 2=PAGE LAYOUT, 3=TRNSP ONLY, <CR>=OLD  '$)
09300	2000	FORMAT(I)
09400	CC543	READ(1,2,END=343),KNM(JNM),(KPN(K),K=1,30)
09500	543	CALL IFILE(1,KS)
09600	843	CALL READX(1,KNM(JNM),EXT,KEND,NUMS)
09700		IF(KEND)GO TO 343
09800		JNM=JNM+1
09900		DO 434 K=1,30
10000		J=KPN(K)
10100		JPG=JPG+1
10200		NRD(JPG)=J
10300	C  BE CAREFUL ABOUT RUNNING OVER NRD ARRAY (100)-- ZEROS ARE INSERTED***********
10400	434	IF(J.EQ.0)GO TO 843
10500		GO TO 843
10600	CC3000	CALL NAMEXT     
10700	3000	CALL READX(5,NAMX,EXT,KEND,NUMS)
10800		KNM(1)=NAMX
12200		END
65800		SUBROUTINE READX(IDEV,NAME,IEXT,KEND,NUMS)
65900		COMMON /PTR/INP(72)
66000		DIMENSION FORM2(5),FORMT(5),NUMS(30)
66100		DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
66200		1, FORM3/'30I)'/
66300	1	FORMAT(72A1)
66400	CC	IEXT='MS'
66500	CC	ACCEPT 1,INP
66600		KEND=0
66700	C IDEV=DEVICE NUMBER (1=DSK, 5=TTY)
66800		READ(IDEV,1,END=12)INP
66900		DO 2 K=2,72
67000		IF(INP(K).EQ.' ')GO TO 3
67100	2	IF(INP(K).EQ.'.')GO TO 4
67200	3	FORMT(3)=FORM3
67300		FORMT(4)=' '
67400		FORMT(5)=' '
67500	5	FORMT(2)=FORM2(K-1)
67600		REREAD FORMT,NAME,NUMS
67700		GO TO 10
67800	4	FORMT(3)=FORM2(1)
67900	C  CATCHES DOT
68000		DO 7 N=K+1,72
68100	7	IF(INP(N).EQ.' ')GO TO 8
68200	8	FORMT(4)=FORM2(N-K-1)
68300		FORMT(5)=FORM3
68400		FORMT(2)=FORM2(K-1)
68500		REREAD FORMT,NAME,K,IEXT,NUMS
68600		CALL LO2UP(IEXT)
68700	10	CALL LO2UP(NAME)
68800		RETURN
68900	12	KEND=-1
69000		END
69100	
69200		SUBROUTINE LO2UP(J)
69300	C CONVERTS ALL LOWER CASE TO UPPER CASE.
69400		J=J.AND..NOT.((J/2).AND."201004020100)
69500		END
69600	
69700		FUNCTION TSIG(Q,J)
69800		DIMENSION Q(1)
69900		TSIG=IFIX(Q(J+5)*100.0+Q(J+6)+.5)
70000	C COMBINES METER NUMS.  (2/4 = 204. ETC.)
70100		END